home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Info-Mac 4
/
Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso
/
Development
/
Source
/
DBL Pascal Library
/
DebuggerTest ƒ
/
DebuggerTest.p
< prev
next >
Wrap
Text File
|
1993-12-17
|
8KB
|
222 lines
unit DebuggerTest;
interface
type
DebuggerKind = ( {}
debuggerKindNone, {}
debuggerKindMacsBug, {}
debuggerKindTMON, {}
debuggerKindJasik, {}
debuggerKindABZmon, {}
debuggerKindOther {}
);
DebuggerSignature = packed array[1..2] of Char;
{$IFC (UNDEFINED DebuggerTest_Signature) | DebuggerTest_Signature}
procedure GetDebuggerInfo (var present, active: Boolean; var kind: DebuggerKind; var signature: DebuggerSignature);
{$ENDC}
{ABZmon can load “on top of” another debugger. In this case, the underlying debugger}
{becomes the secondary debugger, but is the only one reported by GetDebuggerInfo, which}
{looks in the “normal” places before trying to find ABZmon. The ABZMonIsLoaded function}
{can be used to detect ABZmon’s presence when not the only debugger.}
function ABZMonIsLoaded: Boolean;
function DebuggerPresent: Boolean;
implementation
function ValidDebuggerWorldAddress (p: univ Ptr): Boolean;
begin
{Address must be even and somewhere within addressable RAM or ROM.}
ValidDebuggerWorldAddress := not ODD(ORD(p)) and (ORD(p) >= 0) and (ORD(p) < ORD(MFTopMem));
end;
type
LongPtr = ^Longint;
IntPtr = ^Integer;
PtrPtr = ^Ptr;
function GetVBR: Ptr;
inline
$7008, {MOVEQ #$EnterSupervisorMode,D0}
$A08D, {_DebugUtil}
$4E7A, $8801, {MOVEC VBR,A0}
$46C0, {MOVE D0,SR ;restore user mode}
$2E88; {MOVE.L A0,(A7)}
function ABZMonIsLoaded: Boolean;
const
_DebugUtil = $A08D;
_Unimplemented = $A89F;
var
VBR: Ptr;
vectorPtr: PtrPtr;
codePtr: LongPtr;
err: OSErr;
begin
{Alain Birtz’s ABZmon doesn’t use MacJmp at all. In fact, it doesn’t even use}
{the trap dispatcher table. Instead, it patches the trap dispatcher! The hint for}
{finding this, aside from not finding it anywhere else, is that ABZmon defines}
{a private trap _DebugNum $AAFF - this has reserved bit 9 set. ABZmon’s trap}
{dispatcher can be identified by its first instruction, ORI #$700,SR. In hex, this}
{is $007C0700.}
if GetOSTrapAddress(_DebugUtil) = GetToolTrapAddress(_Unimplemented) then
VBR := Ptr(0)
else
begin
if DebuggerGetMax >= 8 then
VBR := GetVBR
else
VBR := Ptr(0);
end;
if ValidDebuggerWorldAddress(VBR) then
begin
vectorPtr := PtrPtr(ORD(VBR) + $28);
codePtr := LongPtr(vectorPtr^);
ABZMonIsLoaded := ValidDebuggerWorldAddress(codePtr) & (codePtr^ = $007C0700);
end
else
ABZMonIsLoaded := False;
end;
{$IFC (UNDEFINED DebuggerTest_Signature) | DebuggerTest_Signature}
function NonStandardDebuggerKind (entry: univ Ptr): DebuggerKind;
begin
NonStandardDebuggerKind := debuggerKindOther; {If we can’t decide…}
{Jasik’s “The Debugger” doesn’t have a world pointer. Its distinguishing}
{feature is a test for whether it was entered via an F-line trap, by executing}
{the instruction CMPI #10,DSErrCode. In hex this is $0C7800100AF0.}
if (LongPtr(entry)^ = $0C780010) and (IntPtr(ORD(entry) + SIZEOF(Longint))^ = $0AF0) then
NonStandardDebuggerKind := debuggerKindJasik
else
{Add other tests as needed.}
;
end;
{$ENDC}
{This is based on info from “MacsBug Reference and Debugging Guide for MacsBug version 6.2”}
{The MacsBug reference doesn’t mention that the ROM debugger masquerades as a real debugger.}
{Because the ROM debugger doesn’t have a “world” pointer, we have to do some extra checks.}
procedure GetDebuggerInfo (var present, active: Boolean; var kind: DebuggerKind; var signature: DebuggerSignature);
const
{The first and current universal ROM is rev 1660. Assume}
{that future universal ROMs will have higher rev numbers.}
UnivROMVersion = 1660;
MacJmp = $120;
Debug32Flags = $BFF;
ROMBase = $2AE;
DebugInstalledFlagBit = 5;
DebugActiveFlagBit = 7;
Megabyte = $100000;
{The following gestalt selectors are from Rene G.A. Ros’ SGSL.}
gestaltEnablerAttr = 'bugy'; {32-bit System Enabler [1.0]}
gestaltEnabler32bit = 7; {32-bit enabler present}
type
PtrPtr = ^Ptr;
IntPtr = ^Integer;
SigPtr = ^DebuggerSignature;
var
err: OSErr;
gestaltResult: Longint;
MM32Bit, univROM, apple32BitEnabler, broken: Boolean;
debugFlagsAddr: Ptr;
debugEntryAddr, debugWorldAddr, ROMBaseAddr: Ptr;
begin
err := Gestalt(gestaltAddressingModeAttr, gestaltResult);
MM32Bit := (err = noErr) & BTST(gestaltResult, gestalt32BitAddressing);
err := Gestalt(gestaltROMVersion, gestaltResult);
UnivROM := (err = noErr) & (gestaltResult >= UnivROMVersion);
err := Gestalt(gestaltEnablerAttr, gestaltResult);
apple32BitEnabler := (err = noErr) & BTST(gestaltResult, gestaltEnabler32bit);
{According to the reference, debugger flags are located in the high byte of}
{MacJmp unless the machine is 32-bit capable, in which case they move to}
{$BFF. I’m not sure I believe that the 32-bit enablers (Connectix’s MODE32}
{and Apple’s 32-bit System Enabler) report the right thing w.r.t. 32-bit capability.}
{Clearly, if the machine is running in 32-bit mode, it’s 32-bit capable even under}
{the enablers. But when running under a 32-bit enabler in 24-bit mode, the enabler}
{would seem to be obliged to report 32-bit capability. In this state, I wouldn’t expect}
{the enabler to put up enough of a charade to move the debugger flags — they’d almost}
{certainly end up in the high byte of MacJmp. Also, Apple’s enabler is damaged in}
{the opposite case — the debugger traps still look at the high byte of MacJmp even in}
{32-bit mode. This requires a special test to pretend there’s no debugger present under}
{Apple’s 32-bit System Enabler in 32-bit addressing mode; 24-bit mode is OK.}
broken := apple32BitEnabler and MM32Bit;
if not broken then
begin
if MM32Bit or UnivROM then
debugFlagsAddr := Ptr(Debug32Flags)
else
debugFlagsAddr := Ptr(MacJmp);
present := BTST(debugFlagsAddr^, DebugInstalledFlagBit);
active := BTST(debugFlagsAddr^, DebugActiveFlagBit);
end
else
begin
present := False;
active := False;
end;
if present then
begin
debugEntryAddr := StripAddress(PtrPtr(MacJmp)^);
ROMBaseAddr := StripAddress(PtrPtr(ROMBase)^);
if ORD(debugEntryAddr) > ORD(ROMBaseAddr) then {Could be the ROM debugger…}
if MM32Bit then
begin {In 32-bit mode, any address in or beyond ROM is not in RAM.}
present := False;
Exit(GetDebuggerInfo);
end
else if ORD(debugEntryAddr) <= ORD(ROMBaseAddr) + Megabyte then
begin {In 24-bit mode, the ROM gets 1MB and can be followed by RAM.}
present := False;
Exit(GetDebuggerInfo);
end;
{$IFC (UNDEFINED DebuggerTest_Signature) | DebuggerTest_Signature}
debugWorldAddr := PtrPtr(ORD(debugEntryAddr) - SIZEOF(Ptr))^;
if ValidDebuggerWorldAddress(debugWorldAddr) then
signature := SigPtr(debugWorldAddr)^
else
signature := '??';
case Integer(signature) of
$4D54: {MT}
kind := debuggerKindMacsBug;
{• This is from memory; I _think_ TMON registers itself this way…}
$5748: {WH}
kind := debuggerKindTMON;
otherwise
kind := NonStandardDebuggerKind(debugEntryAddr);
end;
{$ENDC}
end
{Alain Birtz’s ABZmon doesn’t put anything in MacJmp, but patches the trap dispatcher.}
else if ABZMonIsLoaded then
begin
kind := debuggerKindABZmon;
{$IFC (UNDEFINED DebuggerTest_Signature) | DebuggerTest_Signature}
signature := '??';
{$ENDC}
present := True;
end
else {No debugger present.}
begin
kind := debuggerKindNone;
{$IFC (UNDEFINED DebuggerTest_Signature) | DebuggerTest_Signature}
signature := ' ';
{$ENDC}
end;
end;
function DebuggerPresent: Boolean;
var
present, active: Boolean;
kind: DebuggerKind; {this never gets a value}
signature: DebuggerSignature; {this never gets a value}
begin
GetDebuggerInfo(present, active, kind, signature);
DebuggerPresent := present;
end;
end.